home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / MSNP12_VB_2047842142007.psc / MSNP12 VB / Modules / modChallenge.bas next >
BASIC Source File  |  2007-02-13  |  5KB  |  132 lines
  1. Attribute VB_Name = "modChallenge"
  2. Option Explicit
  3.  
  4. '=======================================================================
  5. ' Copyright 2005, Siebe "Inky" Tolsma, All rights reserved
  6. ' Math functions based on Troy Osborne's (admin@defyboy.com) implementation
  7. ' Initially based on documentation by ZoRoNaX
  8. '=======================================================================
  9.  
  10. Public Function CreateQRY(strChallenge As String, Optional strClientID As String = "PROD0090YUAUV{2B", Optional strClientCode As String = "YMM8C_H7KCQ2S_KL")
  11.     'First we need to create 32 bit integers from an MD5 Hash
  12.     Dim strMD5 As String, strMD5Ints() As String
  13.     strMD5 = MD5_Hex(strChallenge & strClientCode)
  14.     strMD5Ints = MD5HexToInt(strMD5)
  15.  
  16.     'Then we repeat the process with almost the same steps, just with two different strings
  17.     Dim strCHL As String, strCHLInts() As String
  18.     strCHL = strChallenge & strClientID
  19.     strCHL = strCHL & String$(8 - (Len(strCHL) Mod 8), "0")
  20.     strCHLInts = CHLHexToInt(strCHL)
  21.  
  22.     'Create the XOR key (Hi/Lo) :-)
  23.     Dim strXORKey As String, strHigh As String, strLow As String
  24.     strXORKey = CreateKey(strMD5Ints, strCHLInts)
  25.     strHigh = Mid$(strXORKey, 1, 8): strLow = Mid$(strXORKey, 9, 8)
  26.  
  27.     'And finally XOR the key
  28.     Dim strMD5P() As String: strMD5P = ChopString(strMD5, 8)
  29.     strMD5P(0) = LCase$(hexXOr(strMD5P(0), strHigh) & hexXOr(strMD5P(1), strLow))
  30.     strMD5P(1) = LCase$(hexXOr(strMD5P(2), strHigh) & hexXOr(strMD5P(3), strLow))
  31.     
  32.     'Pad it and return it :-)
  33.     CreateQRY = String$(16 - Len(strMD5P(0)), "0") & strMD5P(0) & _
  34.                 String$(16 - Len(strMD5P(1)), "0") & strMD5P(1)
  35. End Function
  36.  
  37. Private Function MD5HexToInt(strMD5 As String) As String()
  38.     'Chop the MD5 hash into pieces of 8
  39.     Dim strMD5Ints() As String, I As Integer
  40.     strMD5Ints = ChopString(strMD5, 8)
  41.     
  42.     'Loop over the chunks given to use and create the appropriate integers from it
  43.     For I = 0 To UBound(strMD5Ints)
  44.         'Store the value :-)
  45.         strMD5Ints(I) = CStr(CDbl("&H" & SwapBytes(strMD5Ints(I))) And &H7FFFFFFF)
  46.     Next I
  47.     
  48.     'Return them
  49.     MD5HexToInt = strMD5Ints
  50. End Function
  51.  
  52. Private Function CHLHexToInt(strCHL As String) As String()
  53.     'Chop the string into pieces of 4
  54.     Dim strCHLInts() As String, I As Integer
  55.     strCHLInts = ChopString(strCHL, 4)
  56.     
  57.     'Loop over the entries in the array and create integers from them
  58.     For I = 0 To UBound(strCHLInts)
  59.         'Store the value :-)
  60.         strCHLInts(I) = CStr(CDbl("&H" & SwapBytes(BinToHex(strCHLInts(I)))))
  61.     Next I
  62.     
  63.     'Return them
  64.     CHLHexToInt = strCHLInts
  65. End Function
  66.  
  67. Private Function CreateKey(strMD5Ints() As String, strCHLInts() As String, Optional strMagicKey As String = "&H0E79A9C1") As String
  68.     'Initialize variables |-)
  69.     Dim strHigh As String, strLow As String, strTemp As String
  70.     strHigh = "0": strLow = "0": strTemp = "0"
  71.     
  72.     'And some more (So we dont have to calculate these each time
  73.     Dim strH7F As String, I As Integer
  74.     strH7F = CStr(Int("&H7FFFFFFF"))
  75.     strMagicKey = CStr(Int(strMagicKey))
  76.     
  77.     'Then walk over the strCHLInts array (Stepping 2 at a time)
  78.     For I = 0 To UBound(strCHLInts) Step 2
  79.         'First calculate the temporary variable
  80.         strTemp = strMod(strMul(strCHLInts(I), strMagicKey), strH7F)
  81.         strTemp = strMul(strAdd(strTemp, strHigh), strMD5Ints(0))
  82.         strTemp = strMod(strAdd(strTemp, strMD5Ints(1)), strH7F)
  83.         
  84.         'Then the high part of the key
  85.         strHigh = strMod(strAdd(strCHLInts(I + 1), strTemp), strH7F)
  86.         strHigh = strAdd(strMul(strHigh, strMD5Ints(2)), strMD5Ints(3))
  87.         strHigh = strMod(strHigh, strH7F)
  88.         
  89.         'Then add them to the low part of the key
  90.         strLow = strAdd(strAdd(strLow, strHigh), strTemp)
  91.     Next I
  92.     
  93.     'Final step of the official part :-)
  94.     strHigh = strMod(strAdd(strHigh, strMD5Ints(1)), strH7F)
  95.     strLow = strMod(strAdd(strLow, strMD5Ints(3)), strH7F)
  96.     
  97.     'Swap the bytes around and output as hex
  98.     CreateKey = SwapBytes(strDecToHex(strHigh)) & SwapBytes(strDecToHex(strLow))
  99. End Function
  100.  
  101. Private Function ChopString(strString As String, iLength As Integer) As String()
  102.     Dim strChunks() As String, I As Integer
  103.     
  104.     'Create a For loop
  105.     For I = 0 To Len(strString) - 1 Step iLength
  106.         'Redim the array accordingly, "Push" the value into the array
  107.         ReDim Preserve strChunks(I / iLength) As String
  108.         strChunks(I / iLength) = Mid$(strString, I + 1, iLength)
  109.     Next I
  110.     
  111.     'Pass it back to wherever
  112.     ChopString = strChunks
  113. End Function
  114.  
  115. Private Function SwapBytes(strValue As String) As String
  116.     'Swap the bytes around for this value (Hex = No overflow ^_^)
  117.     Dim I As Integer
  118.     For I = 1 To Len(strValue) Step 2
  119.         'Take each 2 characters and put them up front, slowly swapping bytes
  120.         SwapBytes = Mid$(strValue, I, 2) & SwapBytes
  121.     Next I
  122. End Function
  123.  
  124. Private Function BinToHex(strString As String) As String
  125.     'Output the string as hex
  126.     Dim I As Integer
  127.     For I = 1 To Len(strString)
  128.         'Take a character, find the ASCII value and convert it to Hex (Base 16)
  129.         BinToHex = BinToHex & Hex$(Asc(Mid$(strString, I, 1)))
  130.     Next I
  131. End Function
  132.